home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / midi / misc / Midi2TeX / src / tp_m2tf2.pas < prev    next >
Pascal/Delphi Source File  |  1992-07-28  |  9KB  |  331 lines
  1. UNIT TP_M2TF2;
  2.  
  3. INTERFACE
  4.  
  5. uses TP_decl,TP_debug,TP_misc;
  6.  
  7.  
  8. procedure ReadBlock(VAR FilRec : FileRecord);
  9. Function ReadByte(VAR FilRec : FileRecord) : Byte;
  10. Function ReadLongInt(VAR FilRec : FileRecord) : LongInt;
  11. Function ReadInteger(VAR FilRec : FileRecord) : Integer;
  12. Function ReadVarLen(VAR FilRec : FileRecord) : LONGINT;
  13. Function ReadString(VAR FilRec : FileRecord;len : integer) : STRING;
  14. Function GetFilePos(VAR FilRec : FileRecord) : LONGINT;
  15. PROCEDURE SetFilePos(VAR FilRec : FileRecord;Pst : LONGINT);
  16. Procedure C2Pstring(VAR Cstr : STRING);
  17. Procedure P2Cstring(VAR Pstr : STRING);
  18. Procedure InitFilRec(VAR FilRec : FileRecord);
  19. Procedure KillFilRec(VAR FilRec : FileRecord);
  20. Procedure RestoreLastRead(VAR FilRec : FileRecord);
  21. IMPLEMENTATION
  22.  
  23.  
  24. (**************************************************)
  25.       procedure ReadBlock(VAR FilRec : FileRecord);
  26. (**************************************************)
  27. Begin
  28. With FilRec Do
  29.     Begin
  30.     (* there is a request to read a block. If the EOF is reached exit *)
  31.     If LastBlockRead Then ErrorExit(24);
  32.     Seek(MidiFile,FilePosition);
  33.     IF BufSemaphore>0 Then
  34.          Begin
  35.          Move(ReadBuf^[BufPoint],ReadBuf^[1],BufSemaphore);
  36.          BufPoint:=BufSemaphore;
  37.          End
  38.     Else
  39.          BufPoint:=1;
  40.  
  41.     BlockRead(MidiFile, ReadBuf^[BufPoint],BufSize-BufPoint+1,ReadIn);
  42.     BufSemaphore:=BufSemaphore+ReadIn;
  43.     If Debug Then WriteDebugInfo('Bufsemaphore : '+W2S(BufSemaphore));
  44.     If ReadIn<(BufSize-BufPoint+1) Then
  45.         Begin
  46.         LastBlockRead:=TRUE;
  47.         If Debug then WriteDebugInfo('Read in last block in file');
  48.         End
  49.     Else
  50.         LastBlockRead:=FALSE;
  51.     BufPoint:=1;
  52.     FilePosition:=FilePos(MidiFile);
  53.     End;
  54. End; (* ReadBlock *)
  55.  
  56. (*************************************************)
  57.     Function ReadByte(VAR FilRec : FileRecord) : Byte;
  58. (*************************************************)
  59. BEGIN
  60. With FilRec Do
  61.     Begin
  62.     If BufSemaphore<1 Then ReadBlock(FilRec);
  63.     ReadByte:=ReadBuf^[BufPoint];
  64.     DEC(BufSemaphore);
  65.     INC(BufPoint);
  66.     INC(BytesProcessed);
  67.     LastNoBytesRead:=1;
  68.     If LastBlockRead AND (BufPoint=BufSemaphore) THEN
  69.         BEGIN
  70.         NoMoreData:=TRUE;
  71.         If Debug then WriteDebugInfo('There are no more data');
  72.         End
  73.     Else
  74.         NoMoreData:=FALSE;
  75.     End;
  76. END; (* ReadByte *)
  77.  
  78. {$IFDEF PC}
  79. (*******************************************************)
  80.     Function ReadLongInt(VAR FilRec : FileRecord) : LongInt;
  81. (*******************************************************)
  82. VAR  TmpLI : LongInt;
  83.      cnt   : INTEGER;
  84.      b     : Byte;
  85. BEGIN
  86. With FilRec Do
  87.     Begin
  88.     If BufSemaphore<4 Then ReadBlock(FilRec);
  89.     TmpLI:=0;
  90.     For cnt:=0 To 3 DO
  91.         Begin
  92.         Move(ReadBuf^[BufPoint+cnt],b,1);
  93.         TmpLI:=256*TmpLI+b;
  94.         End;
  95.     INC(BufPoint,4);
  96.     DEC(BufSemaphore,4);
  97.     INC(BytesProcessed,4);
  98.     LastNoBytesRead:=4;
  99.     If LastBlockRead AND (BufPoint=BufSemaphore) THEN
  100.         BEGIN
  101.         NoMoreData:=TRUE;
  102.         If Debug then WriteDebugInfo('There are no more data');
  103.         End
  104.     Else
  105.         NoMoreData:=FALSE;
  106.     ReadLongInt:=TmpLI;
  107.     End;
  108. END; (* ReadLongInt *)
  109.  
  110.  
  111. (*******************************************************)
  112.     Function ReadInteger(VAR FilRec : FileRecord) : Integer;
  113. (*******************************************************)
  114. VAR  TmpInt,
  115.      cnt : Integer;
  116.      b   : Byte;
  117. BEGIN
  118. With FilRec Do
  119.     Begin
  120.     If BufSemaphore<2 Then ReadBlock(FilRec);
  121.     TmpInt:=0;
  122.     For cnt:=0 To 1 Do
  123.         Begin
  124.         Move(ReadBuf^[BufPoint+cnt],b,1);
  125.         TmpInt:=256*TmpInt+b;
  126.         End;
  127.     DEC(BufSemaphore,2);
  128.     INC(BufPoint,2);
  129.     INC(BytesProcessed,2);
  130.     LastNoBytesRead:=2;
  131.     If LastBlockRead AND (BufPoint=BufSemaphore) THEN
  132.         BEGIN
  133.         NoMoreData:=TRUE;
  134.         If Debug then WriteDebugInfo('There are no more data');
  135.         End
  136.     Else
  137.         NoMoreData:=FALSE;
  138.     ReadInteger:=TmpInt;
  139.     End;
  140. END; (* ReadInteger *)
  141. {$ENDIF}
  142.  
  143. {$IFDEF ST}
  144. (*******************************************************)
  145.     Function ReadInteger(VAR FilRec : FileRecord) : Integer;
  146. (*******************************************************)
  147. VAR  TmpInt : Integer;
  148. BEGIN
  149. With FilRec Do
  150.     Begin
  151.     If BufSemaphore<2 Then ReadBlock(FilRec);
  152.     Move(ReadBuf^[BufPoint],TmpInt,2);
  153.     DEC(BufSemaphore,2);
  154.     INC(BufPoint,2);
  155.     INC(BytesProcessed,2);
  156.     LastNoBytesRead:=2;
  157.     If LastBlockRead AND (BufPoint=BufSemaphore) THEN
  158.         BEGIN
  159.         NoMoreData:=TRUE;
  160.         If Debug then WriteDebugInfo('There are no more data');
  161.         End
  162.     Else
  163.         NoMoreData:=FALSE;
  164.     ReadInteger:=TmpInt;
  165.     End;
  166. END; (* ReadInteger *)
  167.  
  168. (*******************************************************)
  169.     Function ReadLongInt(VAR FilRec : FileRecord) : LongInt;
  170. (*******************************************************)
  171. VAR  TmpLI : LongInt;
  172. BEGIN
  173. With FilRec Do
  174.     Begin
  175.     If BufSemaphore<4 Then ReadBlock(FilRec);
  176.     Move(ReadBuf^[BufPoint],TmpLI,4);
  177.     INC(BufPoint,4);
  178.     DEC(BufSemaphore,4);
  179.     INC(BytesProcessed,4);
  180.     LastNoBytesRead:=4;
  181.     If LastBlockRead AND (BufPoint=BufSemaphore) THEN
  182.         BEGIN
  183.         NoMoreData:=TRUE;
  184.         If Debug then WriteDebugInfo('There are no more data');
  185.         End
  186.     Else
  187.         NoMoreData:=FALSE;
  188.     ReadLongInt:=TmpLI;
  189.     End;
  190. END; (* ReadLongInt *)
  191. {$ENDIF}
  192.  
  193. (******************************************************)
  194.     Function ReadVarLen(VAR FilRec : FileRecord) : LONGINT;
  195. (******************************************************)
  196. VAR Tmp : LONGINT;
  197.     Bt  : Byte;
  198.     Cnt : Byte;
  199. BEGIN
  200. Cnt:=1;
  201. With FilRec DO
  202.     Begin
  203.     tmp:=0;
  204.     Bt:=ReadByte(FilRec);
  205.     
  206.     If (Bt AND $80)>0 Then
  207.        Begin
  208.        Repeat
  209.         Bt:=Bt and $7f;
  210.         tmp:=tmp+Bt;
  211.         tmp := tmp SHL 7;
  212.         Bt:=ReadByte(FilRec);
  213.         Inc(Cnt);
  214.        Until (Bt AND $80)=0;
  215.        tmp:=tmp+Bt;
  216.        End
  217.     Else
  218.        tmp:=Bt;
  219.  
  220.     ReadVarLen:=tmp;
  221.     LastNoBytesRead:=Cnt;
  222.     End;
  223. END; (* ReadVarLen *)
  224.  
  225. (*******************************************************************)
  226.     Function ReadString(VAR FilRec : FileRecord;len : integer) : STRING;
  227. (*******************************************************************)
  228. VAR TmpStr : String[80];
  229. BEGIN
  230. With FilRec Do
  231.     Begin
  232.     If BufSemaphore<len Then ReadBlock(FilRec);
  233.     TmpStr[0]:=Chr(len);
  234.     Move(ReadBuf^[BufPoint],TmpStr[1],len);
  235.     DEC(BufSemaphore,len);
  236.     INC(BufPoint,len);
  237.     INC(BytesProcessed,len);
  238.     LastNoBytesRead:=len;
  239.     If LastBlockRead AND (BufPoint=BufSemaphore) THEN
  240.         BEGIN
  241.         NoMoreData:=TRUE;
  242.         If Debug then WriteDebugInfo('There are no more data');
  243.         End
  244.     Else
  245.         NoMoreData:=FALSE;
  246.     ReadString:=TmpStr;
  247.     End;
  248. END; (* ReadString *)
  249.  
  250. (********************************************)
  251.     Procedure C2Pstring(VAR Cstr : STRING);
  252. (********************************************)    
  253. VAR
  254.    nilpos : BYTE;
  255. BEGIN
  256.  Cstr[0]:=#80;
  257.  nilpos:=(pos(#00,Cstr));
  258.  Cstr[0]:=Chr(nilpos);
  259. End; (* C2Pstring *)
  260.  
  261. (********************************************)
  262.     Procedure P2Cstring(VAR Pstr : STRING);
  263. (********************************************)    
  264. VAR L : Byte;
  265. BEGIN
  266. L:=Length(Pstr);
  267. Move(Pstr[1],Pstr[0],L);
  268. Pstr[L]:=#00;
  269. End; (* C2Pstring *)
  270.  
  271.  
  272. (******************************************************)
  273.     Function GetFilePos(VAR FilRec : FileRecord) : LONGINT;
  274. (******************************************************)
  275. Begin
  276. With FilRec Do
  277.      GetFilePos:=FilePos(MidiFile) div 500 + BufPoint-1;
  278. End;
  279.  
  280. (************************************************************)
  281.     PROCEDURE SetFilePos(VAR FilRec : FileRecord;Pst : LONGINT);
  282. (************************************************************)
  283. Begin
  284. With FilRec Do
  285.    Begin
  286.    Seek(MidiFile,Pst);
  287.    BufPoint:=BufSize;
  288.    BufSemaPhore:=0;
  289.    ReadBlock(FilRec);
  290.    End;
  291. End;
  292.  
  293. (************************************************************)
  294.      Procedure InitFilRec(VAR FilRec : FileRecord);
  295. (************************************************************)
  296. Begin
  297. FillChar(FilRec,SizeOf(FilRec),#0);
  298. With FilRec Do
  299.     Begin
  300.     BufPoint:=BufSize;
  301.     If MaxAvail>SizeOf(BufType) Then
  302.         GetMem(ReadBuf,SizeOf(BufType))
  303.     Else
  304.         ErrorExit(9);
  305.     End;
  306. End;
  307.  
  308. (************************************************************)
  309.      Procedure KillFilRec(VAR FilRec : FileRecord);
  310. (************************************************************)
  311. Begin
  312. With FilRec Do
  313.     Begin
  314.     FreeMem(ReadBuf,SizeOf(BufType));
  315.     End;
  316. End;
  317.  
  318. (************************************************************)
  319.   Procedure RestoreLastRead(VAR FilRec : FileRecord);
  320. (************************************************************)
  321. Begin
  322. With FilRec Do
  323.    Begin
  324.    Dec(BufPoint,LastNoBytesRead);
  325.    Dec(BytesProcessed,LastNoBytesRead);
  326.    Inc(BufSemaphore,LastNoBytesRead);
  327.    End
  328. End;
  329.  
  330. BEGIN
  331. END.